home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / chemie / chemcalc / komplexe.gfa (.txt) < prev    next >
Encoding:
GFA-BASIC Atari  |  1992-02-27  |  7.3 KB  |  187 lines
  1. .ll 91
  2. .pl 65
  3. .he KOMPLEXE.ACC    \d
  4. .n4
  5. .fo #                                        (c) 1991 Lothar Buchen, Wuppertal
  6. ' ==============================================================================
  7. '
  8. '                                    Chemcalc
  9. '
  10. '                               Modul: Komplexe
  11. '
  12. '             Demo-ACC zur Demonstration der Übertragung von Formeln
  13. '
  14. '                                    V 0.1
  15. '
  16. '                       (c) 1991 Lothar Buchen, Wuppertal
  17. '
  18. '                              Stand: 17. 11. 1991
  19. '
  20. '                              in GFA-Basic V 3.50
  21. '
  22. ' ==============================================================================
  23. '
  24. $m 1000
  25. $s<
  26. $f<
  27. speicher_min%=FRE(0)
  28. speicher_max%=FRE(0)
  29. ap_id&=APPL_INIT()
  30. DIM message&(63),qu&(7)
  31. ARRAYFILL message&(),-1
  32. ' ============================== Message-System ================================
  33. ' Aufbau: Ungerade Message-Nummern:     keine Antwort
  34. '         Gerade Message-Nummern:       Antwort folgende ungerade Nummer
  35. '
  36. ' ------------------------------ Message-Format: -------------------------------
  37. ' message&(0)  Nachrichtennummer
  38. ' message&(1)  Absender
  39. ' message&(2)  Zusätzliche Bytes der Nachricht; bei Standardlänge von 16 Bytes 0
  40. ' message&(3)  Nicht benutzt   (bei $6603)
  41. ' message&(4)        "
  42. ' message&(5)        "
  43. ' message&(6)        "
  44. ' message&(7)        "
  45. ' message&(8) - message&(63)   Formel
  46. ' ------------------- Zur Zeit benutzte Nachrichtennummern ---------------------
  47. ' message&(0) = $6401         Quittierung einer Nachricht (wird immer gesendet)
  48. ' message&(0) = $64FF         Fataler Fehler ist aufgetreten, ACC meldet sich ab
  49. ' message&(0) = $6502         Fließkommazahl wird angefordert
  50. ' message&(0) = $6503         Fließkommazahl wird gesendet
  51. ' message&(0) = $6504 - $65FF  noch nicht benutzt
  52. ' message&(0) = $6602         Formel wird angefordert
  53. ' message&(0) = $6603         Formel wird gesendet
  54. ' message&(0) = $6604 - $66FF  noch nicht benutzt
  55. ' ------------------------------------------------------------------------------
  56. shadowed|=&H20
  57. disabled|=&H8
  58. meldung$="Komplex-Formeln 0.1, (c) Lothar Buchen, Wuppertal"
  59. PRINT "Installiere "+meldung$+"..."
  60. chemie.rsc$="KOMPLEXE.RSC"
  61. eintrag$="Komplexe"
  62. m_reg$=SPACE$(LEN(eintrag$)+4)
  63. ~@center(eintrag$,m_reg$)
  64. '
  65. IF RSRC_LOAD(chemie.rsc$)=0
  66.   PRINT chemie.rsc$+" fehlt!"
  67.   IF ap_id&>0
  68.     DO                  ! Falls das RSC-File nicht zu finden ist,
  69.       ~EVNT_TIMER(-1)   ! dann einfach lange darauf warten,
  70.     LOOP                ! nichts zu tun.
  71.   ELSE
  72.     END
  73.   ENDIF
  74. ENDIF
  75. '
  76. IF {BASEPAGE+36}=0
  77.   me_id&=MENU_REGISTER(ap_id&,m_reg$)
  78.   DO
  79.     ~EVNT_MESAG(0)
  80.     FOR i|=0 TO 7
  81.       message&(i|)=MENU(i|+1)
  82.     NEXT i|
  83.     message&=message&(0)
  84.     SELECT message&                            ! Nachricht auswerten
  85.     CASE 40,&H6602                             ! 40 vom Desktop, Rest für Spezielles
  86.       SELECT message&
  87.       CASE &H6602
  88.         applikation&=message&(1)               ! Wohin geht die Bestätigung
  89.         qu&(0)=&H6401                          ! Anfrage bestätigen
  90.         qu&(1)=ap_id&                          ! Absender von KOMPLEXE
  91.         qu&(3)=1                               ! Frage akzeptiert
  92.         ~APPL_WRITE(applikation&,16,V:qu&(0))  ! Und abschicken
  93.       ENDSELECT
  94.       ~WIND_UPDATE(3)                          ! Mauskontrolle übernehmen
  95.       hole_daten(ergebnis$)                    ! Daten holen
  96.       ~WIND_UPDATE(2)                          ! Mauskontrolle abgeben
  97.       IF message&(0)=&H6602                    ! Formel angefordert
  98.         message&(0)=&H6603                     ! Nummer der Antwort
  99.         message&(1)=ap_id&                     ! Absender
  100.         message&(2)=LEN(ergebnis$)             ! Länge der Formel
  101.         BMOVE V:ergebnis$,V:message&(8),LEN(ergebnis$)
  102.         ~APPL_WRITE(applikation&,16+LEN(ergebnis$),V:message&(0)) ! Und abschicken
  103.       ENDIF
  104.     ENDSELECT
  105.     ergebnis$=""
  106.     meldung$=""
  107.     ARRAYFILL message&(),-1
  108.   LOOP
  109. ELSE
  110.   DEFMOUSE 0
  111.   DEFFILL 1,2,8
  112.   PBOX 0,0,WORK_OUT(0),22
  113.   GRAPHMODE 3
  114.   DEFTEXT 1,16,0,13
  115.   TEXT 80,17,480,"Komplex-Formeln V 0.1 (c) 1991 Lothar Buchen"
  116.   GRAPHMODE 1
  117.   DEFFILL 1,2,4
  118.   PBOX 0,22,WORK_OUT(0),WORK_OUT(1)
  119.   hole_daten(ergebnis$)
  120.   ~RSRC_FREE()
  121. ENDIF
  122. > PROCEDURE hole_daten(VAR daten$)
  123.   ' ==========================================================================
  124.   '
  125.   '          Objektnummern der Resourcedatei A:\KOMPLEXE.RSC
  126.   '
  127.   '          Anzahl der Objekte:  17
  128.   '
  129.   '          Anzahl der benannten Objekte:   9
  130.   '
  131.   '          Anzahl der Bäume:     1
  132.   '
  133.   '          TEDINFO-Strukturen:   8
  134.   '
  135.   '          ICONBLK-Strukturen:   0
  136.   '
  137.   '          BITBLK-Strukturen:    0
  138.   '
  139.   '          Freie Strings:        0
  140.   '
  141.   '          Freie Images:         0
  142.   '
  143.   ' ==========================================================================
  144.   '
  145.   LET komplexe&=0       ! Baum 0 = Dialog       OB_FLAGS          OB_STATE
  146.   LET en&=3             ! OBJEKT = BOXTEXT   1 0 0 0 1 0 0 0 0   0 0 0 0 0 1
  147.   LET tren&=5           ! OBJEKT = BOXTEXT   1 0 0 0 1 0 0 0 0   0 0 0 0 0 1
  148.   LET tta&=7            ! OBJEKT = BOXTEXT   1 0 0 0 1 0 0 0 0   0 0 0 0 0 1
  149.   LET tan&=9            ! OBJEKT = BOXTEXT   1 0 0 0 1 0 0 0 0   0 0 0 0 0 1
  150.   LET dien&=11          ! OBJEKT = BOXTEXT   1 0 0 0 1 0 0 0 0   0 0 0 0 0 1
  151.   LET glyme&=13         ! OBJEKT = BOXTEXT   1 0 0 0 1 0 0 0 0   0 0 0 0 0 1
  152.   LET ntah3&=15         ! OBJEKT = BOXTEXT   1 0 0 0 1 0 0 0 0   0 0 0 0 0 1
  153.   LET ok&=16            ! OBJEKT = BUTTON    1 0 1 0 0 1 0 0 0   0 0 0 0 0 1
  154.   ' ==========================================================================
  155.   '
  156.   j&=2
  157.   ~RSRC_GADDR(0,komplexe&,komplexe.adr%)
  158.   ~FORM_CENTER(komplexe.adr%,x1&,y1&,b1&,h1&)
  159.   ~FORM_DIAL(0,0,0,0,0,x1&,y1&,b1&,h1&)
  160.   ~FORM_DIAL(1,0,0,0,0,x1&,y1&,b1&,h1&)
  161.   ~OBJC_DRAW(komplexe.adr%,0,5,x1&,y1&,b1&,h1&)
  162.   ex.objc&=FORM_DO(komplexe.adr%,0)
  163.   ~OBJC_CHANGE(komplexe.adr%,ex.objc&,0,x1&,y1&,b1&,h1&,shadowed|,0)
  164.   FOR i&=3 TO 15 STEP 2
  165.     IF BTST(OB_STATE(komplexe.adr%,i&),0)
  166.       OB_STATE(komplexe.adr%,i&)=normal|
  167.       daten$=CHAR{{OB_SPEC(komplexe.adr%,i&)}}
  168.     ENDIF
  169.   NEXT i&
  170.   ~FORM_DIAL(2,0,0,0,0,x1&,y1&,b1&,h1&)
  171.   ~FORM_DIAL(3,0,0,0,0,x1&,y1&,b1&,h1&)
  172. RETURN
  173. > FUNCTION center(zentrier$,VAR org$)
  174.   ' ===========================================================================
  175.   '            Zentriert des String zentrier$ in den String org$
  176.   '            Rückgabe: -1, wenn gelungen
  177.   '                       0, wenn zentrier$ > org$
  178.   ' ===========================================================================
  179.   '
  180.   IF LEN(zentrier$)<=LEN(org$)             ! Wenn zu zentrierender String kürzer
  181.     MID$(org$,LEN(org$)/2+1-LEN(zentrier$)/2)=zentrier$
  182.     RETURN TRUE                            ! Zentrierung gelungen
  183.   ELSE                                     ! String zu lang
  184.     RETURN FALSE                           ! Zentrierung geht nicht
  185.   ENDIF
  186. ENDFUNC
  187.